;*******************************************************************************
; Director - Sort
;
; Copyright (C) 2003, Nick Craig-Wood and Philip Ludlam
;
;This program is free software; you can redistribute it and/or modify it under
;the terms of the GNU General Public License as published by the Free Software
;Foundation; either version 2 of the License, or (at your option) any later
;version.
;
;This program is distributed in the hope that it will be useful, but WITHOUT ANY
;WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
;PARTICULAR PURPOSE. See the GNU General Public License for more details.
;
;You should have received a copy of the GNU General Public License along with
;this program; if not, write to the Free Software Foundation, Inc., 59 Temple
;Place - Suite 330, Boston, MA 02111-1307, USA
;
;*******************************************************************************
;----h- Director.s.Sort
; Name
;   Sort
;
; Purpose
;   Sort
;------
;*******************************************************************************


		TTL	> Sort

		GET	OSLib:oslib.hdr.Wimp
		GET	AsmLib2:hdr.RegsBoth
		GET	AsmLib2:hdr.MacrosBoth
		GET	h.WorkSpace
		GET	h.ListMacros
		GET	h.Constants
		GET	AsmLib2:hdr.DebugBoth
		GET	h.ModuleHead
		GET	h.Memory
		GET	h.Menus
		GET	h.BMG

		AREA	|Sort|, CODE, READONLY


;*******************************************************************************
;----f- Director.s.Sort.Star_QuickSort
; Name
;   Star_QuickSort
;
; Purpose
;   This sorts an array
;
; Entry
;   r0  start of array to sort
;   r1  end of array (inclusive)
;   r2 = size of an object
;   r3  comparison routine
;
; Exit
;   Sorted array
;
; Notes
;   On entry to the comparison routine
;     r0  object1
;     r1  object2
;
;   On exit from the comparison routine
;     Comparison in flags
;------
;*******************************************************************************


Star_QuickSort	FOREXPORT
		LDR	wp, [r12]
		SaveRegs

		BL	qsort

		B	NormalReturn

; DEF PROCqsort(from%, to%)
;  LOCAL i%, j%, pivot$

qsort		ROUTINE	"r0-r8", EXPORT

; from			r0
; to			r1
size$l		RN	r2
compare$l	RN	r3
from$l		RN	r4
to$l		RN	r5
i$l		RN	r6
j$l		RN	r7
pivot$l		RN	r8

		MOV	from$l, r0
		MOV	to$l, r1
recurse$l
		CMP	from$l, to$l
		EXIT	HS

;  pivot$=disc$((from%+to%)/2)

		; Find the centre of from and to to the nearest power of 2

		SUB	r0, to$l, from$l		; 2x the difference
		MOV	r1, size$l			; current step

centre$l	CMP	r1, r0, LSR #1			; are we past centre?
		MOVLO	r1, r1, LSL #1			; try 2x the current step
		BLO	centre$l
		ADD	pivot$l, from$l, r1		; point to pivot

;  i%=from%
;  j%=to%

		MOV	i$l, from$l
		MOV	j$l, to$l

;  REPEAT

partition$l

;    WHILE disc$(i%) < pivot$
;      i%=i%+1
;    ENDWHILE

		; sweep i up until it points to an item which is >= the pivot value
partition1$l
		MOV	r0, i$l
		MOV	r1, pivot$l
		MOV	lr, pc
		MOV	pc, compare$l			; compare
		ADDLT	i$l, i$l, size$l
		BLT	partition1$l


;    WHILE disc$(j%) > pivot$
;      j%=j%-1
;    ENDWHILE

		; sweep j down until it points to an item which is <= the pivot value
partition2$l
		MOV	r0, j$l
		MOV	r1, pivot$l
		MOV	lr, pc
		MOV	pc, compare$l			; compare
		SUBGT	j$l, j$l, size$l
		BGT	partition2$l

;    IF i% <= j% THEN
;      SWAP disc$(i%), disc$(j%)
;      i%=i%+1
;      j%=j%-1
;    ENDIF

		; if i and j haven't crossed yet then swap the item which is in the wrong
		; partition

		CMP	i$l, j$l
		BHI	partition_end$l
		MOV	r0, size$l
swap$l
		SUBS	r0, r0, #1
		LDRGEB	r1, [i$l, r0]			; swap the 2 objects, byte at a time
		LDRGEB	lr, [j$l, r0]
		STRGEB	lr, [i$l, r0]
		STRGEB	r1, [j$l, r0]
		BGT	swap$l

		CMP	pivot$l, i$l
		MOVEQ	pivot$l, j$l			; keep pivot pointer up to date
		BEQ	not_j$l
		CMP	pivot$l, j$l
		MOVEQ	pivot$l, i$l			; keep pivot pointer up to date
not_j$l

		ADD	i$l, i$l, size$l
		SUB	j$l, j$l, size$l

;  UNTIL i% > j%

		CMP	i$l, j$l
		BLS	partition$l
partition_end$l


;  IF i% < to% THEN
;    PROCqsort(i%, to%)
;  ENDIF
		MOV	r0, i$l
		MOV	r1, to$l
		CMP	r0, r1
		BLLO	qsort

;  IF j% > from% THEN
;    PROCqsort(from%, j%)
;  ENDIF
		MOV	to$l, j$l
		B	recurse$l			; tail call optimisation

; ENDPROC


;*******************************************************************************
;----f- Director.s.Sort.SortMenuCompare
; Name
;   SortMenuCompare
;
; Purpose
;   This compares two menu entries
;
; Entry
;   r0  menu entry
;   r1  menu entry
;
; Exit
;   flags
;------
;*******************************************************************************


SortMenuCompare	ROUTINE	"r0-r1"

		LDR	r0, [r0, #Wimp_MenuEntry_data + Wimp_IconData_indirected_text_text]
		LDR	r1, [r1, #Wimp_MenuEntry_data + Wimp_IconData_indirected_text_text]
		BL	strcmpit

		EXIT					; return with flags


;*******************************************************************************
;----f- Director.s.Sort.SortMenuBlockP
; Name
;   SortMenuBlockP
;
; Purpose
;   This sorts a menu
;   Don't try sorting menu blocks with keys
;
; Entry
;   r0  start element
;   r1  end element (inclusive) (or large for end)
;
; Exit
;   Sorted menu
;------
;*******************************************************************************


SortMenuBlockP	ROUTINE	"r0-r5", EXPORT

		CMP	r0, r1
		EXIT	HS				; end if short

		LDR	r4, [r0, #Wimp_MenuEntry_menu_flags] ; indirected title status
		BIC	lr, r4, #Wimp_MenuTitleIndirected
		STR	lr, [r0, #Wimp_MenuEntry_menu_flags] ; not indirected title

		LDR	r5, [r1, #Wimp_MenuEntry_menu_flags] ; last and underscore status of last entry
		BIC	lr, r5, #Wimp_MenuLast + Wimp_MenuSeparate
		STR	lr, [r1, #Wimp_MenuEntry_menu_flags] ; not last or dashed

		MOV	r2, #Wimp_MenuEntry		; r2 = block size
		ADR	r3, SortMenuCompare		; comparison routine
		BL	qsort

		LDR	lr, [r0, #Wimp_MenuEntry_menu_flags] ; indirected title status
		AND	r4, r4, #Wimp_MenuTitleIndirected
		BIC	lr, lr, #Wimp_MenuTitleIndirected
		ORR	lr, lr, r4			; glue indirected status back on
		STR	lr, [r0, #Wimp_MenuEntry_menu_flags]

		LDR	lr, [r1, #Wimp_MenuEntry_menu_flags] ; last and underscore status of last entry
		AND	r5, r5, #Wimp_MenuLast + Wimp_MenuSeparate
		BIC	lr, lr, #Wimp_MenuLast + Wimp_MenuSeparate
		ORR	lr, lr, r5			; glue last and dash back on
		STR	lr, [r1, #Wimp_MenuEntry_menu_flags]

		EXIT


;*******************************************************************************
;----f- Director.s.Sort.Star_SortMenu
; Name
;   Star_SortMenu
;
; Purpose
;   This sorts a menu.
;  Don't try sorting menu blocks with keys
;
; Entry
;   r0  menu name
;   r1 = start element (or 0 for start)
;   r2 = end element (inclusive) (or large for end)
;
; Exit
;   Sorted menu
;------
;*******************************************************************************


Star_SortMenu	FOREXPORT
		LDR	wp, [r12]
		SaveRegs

		STMFD	sp!, {r1, r2}			; save start, end

		ADR	r1, MenuStoredAnchor
		BL	MenuBlockFind			; r0  found, r1  previous
		BNE	NoMenu
		MOV	r11, r0				; r11  menu block

		LDMFD	sp!, {r0, r1}			; restore start, end

		BL	SortMenuBlock

		B	NormalReturn


;*******************************************************************************
;----f- Director.s.Sort.SortMenuBlock
; Name
;   SortMenuBlock
;
; Purpose
;   This sorts a menu
;   Don't try sorting menu blocks with keys
;
; Entry
;   r0 = start element (or 0 for start)
;   r1 = end element (inclusive) (or large for end)
;   r11  menu block
;
; Exit
;   Sorted menu
;------
;*******************************************************************************


SortMenuBlock	ROUTINE	"r0-r3", EXPORT

		LDR	lr, [r11, #MenuBlock_entries]
		SUBS	lr, lr, #1
		EXIT	LT				; exit if no entries
		CMP	r1, lr
		MOVGT	r1, lr				; truncate to maximum length

		LDR	r3, [r11, #MenuBlock_menu]	; point to the start of the actual menu
		ADD	r3, r3, #Wimp_Menu_entries	; point to first menu entry in block
		MOV	r2, #Wimp_MenuEntry		; r2 = block size
		MLA	r0, r2, r0, r3			; to
		MLA	r1, r2, r1, r3			; from

		BL	SortMenuBlockP

		EXIT


;*******************************************************************************
;----f- Director.s.Sort.Star_DirectorSortMenu
; Name
;   Star_DirectorSortMenu
;
; Purpose
;   This sorts a menu block
;
; Entry
;
;
; Exit
;
;------
;*******************************************************************************


Help_$Name.SortMenu	FOREXPORT
		[	OSVersion = 310
		DCB	"Sort a menu.", 13
		|
		DCB	"Help_Director_SortMenu", 0
		]

Syntax_$Name.SortMenu	FOREXPORT
		[	OSVersion = 310
		DCB	"Syntax: *$Name.SortMenu <menu> [<from> [<to>]]", 0
		|
		DCB	"Syntax_DirectorSortMenu", 0
		]
		ALIGN

Args_$Name.SortMenu	DCB	"/G,/E,/E", 0
		ALIGN

Star_$Name.SortMenu	FOREXPORT
		LDR	wp, [r12]
Do$Name.SortMenu	SaveRegs
		ROUTINE_SF	NONE
scratch$l	#	0
arg_menu$l	#	4
arg_from$l	#	4
arg_to$l	#	4
space$l		#	scratch_size - :INDEX: @
		END_SF

		MOV	r1, r0				; translate given string
		ADR	r0, Args_$Name.SortMenu
		ADR	r2, scratch$l
		MOV	r3, #scratch_size
		SWI	XOS_ReadArgs
		BVS	ErrorReturn

		LDR	r0, arg_menu$l
		BL	sort_out_gstrans

		LDR	r0, arg_menu$l
		ADR	r1, MenuStoredAnchor
		BL	MenuBlockFind			; r0  found, r1  previous
		BNE	NoMenu
		MOV	r11, r0				; r11  menu block

		LDR	r0, arg_to$l
		CMP	r0, #0
		MOVEQ	r1, #&70000000			; r0 = 0 => default
		BEQ	skip$l
		BL	read_eval
		MOV	r1, r0				; r1 = end entry

skip$l		LDR	r0, arg_from$l
		CMP	r0, #0				; r0 = start entry, 0 is default
		BLNE	read_eval

		BL	SortMenuBlock

exit$l		B	NormalReturn

NoMenu		ReportErrorMT	"$MenuNotFound", Error_MenuNotFound


;*******************************************************************************

		END
